home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / cli / mx2src.arc / BITSTUFF.MOD < prev    next >
Encoding:
Modula Implementation  |  1989-01-05  |  3.9 KB  |  161 lines
  1. (*  Some Functions to perform bit manipulation..  bitsets are a 'bit'
  2.     clumsy (pun intended) to use and don't operate on LONGWORDS,
  3.     so i wrote this.
  4.       It may not be the most efficient, but it is effective, enjoy..
  5.  
  6.     Russ Damske
  7. *)
  8. (*$T-,$S-,$A+ *)
  9. IMPLEMENTATION MODULE BitStuff;
  10.  
  11. FROM SYSTEM IMPORT CODE,BYTE,WORD,LONGWORD, SETREG, REGISTER;
  12.  
  13. (*** FOR LONGWORDS ***)
  14.  
  15. PROCEDURE LAnd( op1, op2 : LONGWORD):LONGWORD;
  16. (* logically AND's 2 longwords *)
  17. BEGIN
  18.   SETREG( 6, op1 );
  19.   SETREG( 7, op2 );
  20.   CODE( 0CE86H );     (* and d6,d7 *)
  21.   RETURN LONGWORD( REGISTER( 7 ) );
  22. END LAnd;
  23.  
  24. PROCEDURE LOr(op1, op2 : LONGWORD):LONGWORD;
  25. (* logically OR's 2 longwords *)
  26. BEGIN
  27.   SETREG( 6, op1 );
  28.   SETREG( 7, op2 );
  29.   CODE( 08E86H );     (* or d6,d7 *)
  30.   RETURN LONGWORD( REGISTER( 7 ) );
  31. END LOr;
  32.  
  33. PROCEDURE LEor(op1, op2 : LONGWORD):LONGWORD;
  34. (* logically Exclusive OR of 2 longwords *)
  35. BEGIN
  36.   SETREG( 6, op1 );
  37.   SETREG( 7, op2 );
  38.   CODE( 0BD87H );     (* eor d6,d7 *)
  39.   RETURN LONGWORD( REGISTER( 7 ) );
  40. END LEor;
  41.  
  42. PROCEDURE LShl(number : LONGWORD; numbits : CARDINAL):LONGWORD;
  43. (*  Shifts number an amount (numbits) left *)
  44. BEGIN
  45.   CODE ( 07C00H );    (* moveq.l #0.d6 *)
  46.   SETREG( 6, numbits );
  47.   SETREG( 7, number );
  48.   CODE( 0EDAFH );    (* lsl d6,d7 *)
  49.   RETURN LONGWORD( REGISTER( 7 ) );
  50. END LShl;
  51.  
  52. PROCEDURE LShr(number : LONGWORD; numbits : CARDINAL):LONGWORD;
  53. (*  Shifts number an amount (numbits) right *)
  54. BEGIN
  55.   CODE( 07C00H );    (* moveq.l #0.d6 *)
  56.   SETREG( 6, numbits );
  57.   SETREG( 7, number );
  58.   CODE( 0ECAFH );    (* lsr d6,d7 *)
  59.   RETURN LONGWORD( REGISTER( 7 ) );
  60. END LShr;
  61.  
  62. (*** FOR WORDS ***)
  63.  
  64. PROCEDURE WAnd( op1, op2 : WORD):WORD;
  65. (* logically AND's 2 words *)
  66. BEGIN
  67.   SETREG( 6, op1 );
  68.   SETREG( 7, op2 );
  69.   CODE( 0CE46H );     (* and d6,d7 *)
  70.   RETURN WORD( REGISTER( 7 ) );
  71. END WAnd;
  72.  
  73. PROCEDURE WOr(op1, op2 : WORD):WORD;
  74. (* logically OR's 2 ords *)
  75. BEGIN
  76.   SETREG( 6, op1 );
  77.   SETREG( 7, op2 );
  78.   CODE( 08E46H );     (* or d6,d7 *)
  79.   RETURN WORD( REGISTER( 7 ) );
  80. END WOr;
  81.  
  82. PROCEDURE WEor(op1, op2 : WORD):WORD;
  83. (* logically Exclusive OR of 2 words *)
  84. BEGIN
  85.   SETREG( 6, op1 );
  86.   SETREG( 7, op2 );
  87.   CODE( 0BD47H );     (* eor d6,d7 *)
  88.   RETURN WORD( REGISTER( 7 ) );
  89. END WEor;
  90.  
  91. PROCEDURE WShl(number : WORD; numbits : CARDINAL):WORD;
  92. (*  Shifts number an amount (numbits) left *)
  93. BEGIN
  94.   CODE ( 07C00H );    (* moveq.l #0.d6 *)
  95.   SETREG( 6, numbits );
  96.   SETREG( 7, number );
  97.   CODE( 0ED6FH );    (* lsl d6,d7 *)
  98.   RETURN WORD( REGISTER( 7 ) );
  99. END WShl;
  100.  
  101. PROCEDURE WShr(number : WORD; numbits : CARDINAL):WORD;
  102. (*  Shifts number an amount (numbits) right *)
  103. BEGIN
  104.   CODE( 07C00H );    (* moveq.l #0.d6 *)
  105.   SETREG( 6, numbits );
  106.   SETREG( 7, number );
  107.   CODE( 0EC6FH );    (* lsr d6,d7 *)
  108.   RETURN WORD( REGISTER( 7 ) );
  109. END WShr;
  110.  
  111. (*** FOR BYTES ***)
  112.  
  113. PROCEDURE BAnd( op1, op2 : BYTE):BYTE;
  114. (* logically AND's 2 BYTES *)
  115. BEGIN
  116.   SETREG( 6, op1 );
  117.   SETREG( 7, op2 );
  118.   CODE( 0CE06H );     (* and d6,d7 *)
  119.   RETURN BYTE( REGISTER( 7 ) );
  120. END BAnd;
  121.  
  122. PROCEDURE BOr(op1, op2 : BYTE):BYTE;
  123. (* logically OR's 2 BYTES *)
  124. BEGIN
  125.   SETREG( 6, op1 );
  126.   SETREG( 7, op2 );
  127.   CODE( 08E06H );     (* or d6,d7 *)
  128.   RETURN BYTE( REGISTER( 7 ) );
  129. END BOr;
  130.  
  131. PROCEDURE BEor(op1, op2 : BYTE):BYTE;
  132. (* logically Exclusive OR of 2 BYTES *)
  133. BEGIN
  134.   SETREG( 6, op1 );
  135.   SETREG( 7, op2 );
  136.   CODE( 0BD07H );     (* eor d6,d7 *)
  137.   RETURN BYTE( REGISTER( 7 ) );
  138. END BEor;
  139.  
  140. PROCEDURE BShl(number : BYTE; numbits : CARDINAL):BYTE;
  141. (*  Shifts number an amount (numbits) left *)
  142. BEGIN
  143.   CODE ( 07C00H );    (* moveq.l #0.d6 *)
  144.   SETREG( 6, numbits );
  145.   SETREG( 7, number );
  146.   CODE( 0ED2FH );    (* lsl d6,d7 *)
  147.   RETURN BYTE( REGISTER( 7 ) );
  148. END BShl;
  149.  
  150. PROCEDURE BShr(number : BYTE; numbits : CARDINAL):BYTE;
  151. (*  Shifts number an amount (numbits) right *)
  152. BEGIN
  153.   CODE( 07C00H );    (* moveq.l #0.d6 *)
  154.   SETREG( 6, numbits );
  155.   SETREG( 7, number );
  156.   CODE( 0EC2FH );    (* lsr d6,d7 *)
  157.   RETURN BYTE( REGISTER( 7 ) );
  158. END BShr;
  159.  
  160. END BitStuff.
  161.